package Schedule::Cron::Finance;

use warnings;
use strict;
use Date::Calc qw/Mktime Localtime/;
use Schedule::Cron;


use base 'Class::Accessor::Complex';


__PACKAGE__
    ->mk_hash_accessors(qw(totals))
    ->mk_accessors(qw(money));


sub new {
    my $self = Schedule::Cron->new(sub { print "dispatch <@_>\n" });
    bless $self, 'FinancialPlan';

    $self->add_entry("0 0 1 * *", sub {
        print "\n";
        $self->print_item(Subtotal => $self->money, 1);
        print "\n";
    });

    # can't go beyond 18 Feb 2037, because of the year 2038 bug?
    # but perl -le'print scalar localtime 2**31-1'
    #   Tue Jan 19 04:14:07 2038
    # hmmm...

    $self->add_entry("0 0 1 1 *",
        sub { $self->{exit}++ if $self->get_year == 2037 }
    );

    $self;
}


sub make_date {
    my ($self, $year, $month, $date) = @_;
    Mktime($year, $month, $date, 0, 0, 0);
}


sub add_amount {
    my ($self, $amount) = @_;
    $self->money($self->money + $amount);
}


sub add_weekly {
    my ($self, $week_day, $item, $amount, $from, $until) = @_;
    my $code_amount = ref $amount eq 'CODE' ? $amount : sub { $amount };
    $self->add_entry("0 0 * * $week_day", sub {
        return if defined($from)  && $self->get_time < $from;
        return if defined($until) && $self->get_time > $until;
        my $amount = $code_amount->();
        $self->add_amount($amount);
        $self->print_item($item, $amount);
    });
}


sub add_monthly {
    my ($self, $mday, $item, $amount, $from, $until) = @_;
    $self->add_annual($mday, '*', $item, $amount, $from, $until);
}


sub add_annual {
    my ($self, $mday, $month, $item, $amount, $from, $until) = @_;
    my $code_amount = ref $amount eq 'CODE' ? $amount : sub { $amount };
    $self->add_entry("0 0 $mday $month *", sub {
        return if defined($from)  && $self->get_time < $from;
        return if defined($until) && $self->get_time > $until;
        my $amount = $code_amount->();
        $self->add_amount($amount);
        $self->print_item($item, $amount);
    });
}


sub add_monthly_repayment {
    my ($self, $mday, $item, $rest_amount, $rate, $from, $until) = @_;
    my $code_rate = ref $rate eq 'CODE' ? $rate : sub { $rate };
    $self->add_entry("0 0 $mday * *", sub {
        return if $rest_amount <= 0;

        return if defined($from)  && $self->get_time < $from;

        # at the end, repay the rest.
        if (defined($until) && $self->get_time > $until) {
            $self->add_amount(-$rest_amount);
            $rest_amount = 0;
            $self->print_item($item, $rest_amount);
            return;
        }

        my $rate = $code_rate->();
        $self->add_amount(-$rate);
        $rest_amount -= $rate;
        $self->print_item_ext($item, "(Rest -$rest_amount)", -$rate);
    });
}


sub add_once {
    my $self = shift;
    my ($mday, $month, $year, $item, $amount);
    # also accept a time number (i.e, generated by Mktime())
    if ($_[0] =~ /^\d{10}$/) {
        my $date = shift;
        ($year, $month, $mday) = Localtime($date);
        ($item, $amount) = @_;
    } else {
        ($mday, $month, $year, $item, $amount) = @_;
    }

    my $code_amount = ref $amount eq 'CODE' ? $amount : sub { $amount };
    $self->add_entry("0 0 $mday $month *" => sub {
        return unless $self->get_year == $year;
        my $amount = $code_amount->();
        $self->add_amount($amount);
        $self->print_item($item => $amount);
    });
}


sub print_item {
    my ($self, $item, $amount, $skip_total) = @_;
    $self->print_item_ext($item, '', $amount, $skip_total);
}


sub print_item_ext {
    my ($self, $item, $additional_info, $amount, $skip_total) = @_;
    printf "%s: %-40s %10.2f\n",
        $self->get_date_string, "$item $additional_info", $amount;
    return if $skip_total;

    $self->totals->{ $self->get_year }{$item} += $amount;
    $self->totals->{'Grand Total'}{$item} += $amount;
}


1;


__END__

{% USE p = PodGenerated %}

=head1 NAME

{% p.package %} - Financial plan scheduler

=head1 SYNOPSIS

    {% p.package %}->new;

=head1 DESCRIPTION

None yet.

=head1 METHODS

=over 4

{% p.write_methods %}

=back

{% p.write_inheritance %}

{% PROCESS standard_pod %}

=cut

